home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb38.arc / OVERUNDR.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-20  |  4KB  |  153 lines
  1. program overunder(input, output);
  2. const
  3.    maxdie       =  6;           (* the maximum # on a die *)
  4.    mindie       =  1;           (* the minimum # on a die *)
  5.  
  6.    maxsum       = 12;           (* maximum sum for two dice *)
  7.    minsum       =  2;           (* minimum sum for two dice *)
  8.  
  9.    startmoney   = 500;          (* amount of money player starts with *)
  10.  
  11. type
  12.    diesum       = mindie..maxsum; (* type for the sum of dice *)
  13.    dietype      = mindie..maxdie; (* a die value *)
  14.    str80        = string[80];     (* a string *)
  15.  
  16. var
  17.    money        : integer;      (* how much money player has *)
  18.    bet          : integer;      (* how much is being bet this time *)
  19.    die          : dietype;      (* value of a die *)
  20.    sum          : diesum;       (* sum of the 2 dice *)
  21.    numnum       : diesum;       (* number picked by player *)
  22.    ch           : char;         (* used to answer questions *)
  23.  
  24.  
  25. (*
  26.  * play
  27.  * throws the dice, prints them out,
  28.  * and keeps score
  29.  *)
  30.  
  31. procedure play;
  32.  
  33.    (*
  34.     * dieroll
  35.     * returns a random die value
  36.     *)
  37.    function dieroll:dietype;
  38.    begin
  39.       dieroll := 1 + random(maxdie)
  40.    end;   (* dieroll *)
  41.  
  42. begin
  43.    writeln('Die#1    Die#2    Sum    Your#     Roll');
  44.    die := dieroll;
  45.    write(die:4,'     ');
  46.    sum := die;
  47.    die := dieroll;
  48.    sum := sum + die;
  49.    write(die:4,'    ',sum:4,'    ',numnum:4,'      ');
  50.    if sum < 7 then
  51.       writeln('Under')
  52.    else
  53.       if sum > 7 then
  54.          writeln('Over')
  55.       else
  56.          writeln('Even');
  57.    if sum = numnum then
  58.    begin
  59.       writeln('You matched!!!!');
  60.       writeln('you get $',bet*4);
  61.       money := money + (bet * 4)
  62.    end
  63.    else
  64.       if ((sum < 7) and (numnum < 7)) or ((sum > 7) and (numnum > 7)) then
  65.       begin
  66.          writeln('You made even money.');
  67.          writeln('you won $',bet);
  68.          money := money + bet
  69.       end
  70.       else
  71.       begin
  72.          writeln('You lost $',bet);
  73.          money := money - bet
  74.       end;
  75.  
  76.    writeln('You new total is $',money)
  77. end;   (* play  *)
  78.  
  79. (*
  80.  * getnumbers
  81.  * get the guess and the bet from the
  82.  * player
  83.  *)
  84.  
  85. procedure getnumbers;
  86.    (*
  87.     * legal
  88.     * gets a number between min
  89.     * and max from the player, with proper error
  90.     * checking
  91.     *)
  92.    function legal(question: str80;min,max:integer):integer;
  93.    var
  94.       num : integer;        (* input number *)
  95.    begin
  96.       num := -1;
  97.       while (num < min) or (num > max) do
  98.       begin
  99.          write(question);
  100.          randomize;
  101.          readln(num);
  102.          if (num < min) or (num > max) then
  103.             writeln('Sorry, only numbers between ',min,' and ',max)
  104.       end;
  105.       legal := num;
  106.    end;   (* legal  *)
  107.  
  108. begin
  109.    numnum := legal('What number do you want? ',minsum,maxsum);
  110.    bet := legal('Your bet? ',1,money);
  111. end;  (* getnumbers  *)
  112.  
  113.  
  114. (*
  115.  * inst
  116.  * print out a list of instructions
  117.  *)
  118.  
  119. procedure inst;
  120. begin
  121.    writeln;
  122.    writeln('Overunder:');
  123.    writeln('A simple dice game.');
  124.    writeln('You choose a number between 2 and 12.');
  125.    writeln('If the sum of two dice rolled is the same');
  126.    writeln('as the number you picked, you win four');
  127.    writeln('times your bet. If your number, and the');
  128.    writeln('dice sum are either both under, or both');
  129.    writeln('over 7, then you win the amount you bet.');
  130.    writeln;
  131.    writeln
  132. end;  (* inst  *)
  133.  
  134.  
  135. begin
  136.    money := startmoney;
  137.    write('Do you want instructions? ');
  138.    readln(ch);
  139.    if (ch = 'y') or (ch = 'Y') then
  140.       inst;
  141.    repeat
  142.       writeln;
  143.       getnumbers;
  144.       writeln;
  145.       play;
  146.       writeln;
  147.       write('Want to try again? ');
  148.       readln(ch);
  149.    until ((ch<>'y') and (ch<>'Y')) or (money <= 0);
  150.    if money <= 0 then
  151.       writeln('Sorry, you''re out of money.')
  152. end.
  153.